home *** CD-ROM | disk | FTP | other *** search
/ IRIS Performer 2.2 Friends Demo / SGI IRIS Performer 2.2 Friends Demo.iso / friends / openworlds / tix / ColorEd.tcl < prev    next >
Text File  |  1997-11-22  |  12KB  |  474 lines
  1. # ColorEd.tcl --
  2. #
  3. #    Implements the GL Widget "TixColorEdit"
  4. #
  5.  
  6. tixWidgetClass tixColorEdit {
  7.     -classname TixColorEdit
  8.     -superclass tixPrimitive
  9.     -method {
  10.     }
  11.     -flag {
  12.     -adjustsize -background -bg -foreground -fg
  13.     -rgb -command -state -disabledforeground
  14.     }
  15.     -configspec {
  16.     {-adjustsize adjustsize Adjustsize 0}
  17.     {-background background Background #ffe4c4}
  18.     {-foreground foreground Foreground black}
  19.     {-rgb rgb Rgb {1.0 1.0 1.0}}
  20.     {-command command Command {}}
  21.     {-state state State normal}
  22.     {-disabledforeground -disabledForeground DisabledForeground #606060}
  23.     }
  24.     -alias {
  25.     {-bg -background}
  26.     {-fg -foreground}
  27.     }
  28. }
  29.  
  30. proc tixColorEdit::InitWidgetRec {w} {
  31.     upvar #0 $w data
  32.  
  33.     tixChainMethod $w InitWidgetRec
  34.  
  35.     set data(flag)    none
  36.     set data(active)  1
  37.     set data(Rscale)  0
  38.     set data(Gscale)  0
  39.     set data(Bscale)  0
  40.     set data(Hscale)  0
  41.     set data(Sscale)  0
  42.     set data(Vscale)  1
  43.  
  44.     set data(oldhsv)  {}
  45.     tixColorEdit::RGBtoHSV  $w
  46. }
  47.  
  48. #--------------------------
  49. # Create Widget
  50. #--------------------------
  51. proc tixColorEdit::ConstructWidget {w} {
  52.     upvar #0 $w data
  53.  
  54.     tixChainMethod $w ConstructWidget
  55.  
  56.     set data(active) 0
  57.  
  58.     set frame1 [tixColorEdit::MkFrame1 $w]
  59.     set frame2 [tixColorEdit::MkFrame2 $w]
  60.     set frame3 [tixColorEdit::MkFrame3 $w]
  61.  
  62.     pack $frame1 -in $w  -side top -fill x
  63.     pack $frame2 -in $w  -side top -fill x
  64.     pack $frame3 -in $w  -side top -fill x
  65.  
  66.     $data(menu1) invoke 0
  67.  
  68.     set data(active) 1
  69. }
  70.  
  71. proc tixColorEdit::MkFrame1 {w} {
  72.     upvar #0 $w data
  73.  
  74.     # 1. MENU
  75.     # -------
  76.     frame $w.menu -relief raised -borderwidth 2
  77.  
  78.     # OPTION MENU
  79.     menubutton $w.menu.option -text "Option" -menu $w.menu.option.m
  80.     menu $w.menu.option.m
  81.  
  82.     set data(scalemode) 1
  83.     set var [format %s(scalemode) $w]
  84.     $w.menu.option.m add radiobutton -label "Value" \
  85.         -command "tixColorEdit::SetScales $w V"         -variable $var -value 1
  86.     $w.menu.option.m add radiobutton -label "HSV" \
  87.     -command "tixColorEdit::SetScales $w HSV"    -variable $var -value 2
  88.     $w.menu.option.m add radiobutton -label "RGB" \
  89.         -command "tixColorEdit::SetScales $w RGB"    -variable $var -value 3
  90.     $w.menu.option.m add radiobutton -label "RGB V" \
  91.         -command "tixColorEdit::SetScales $w RGBV"   -variable $var -value 4
  92.     $w.menu.option.m add radiobutton -label "RGBHSV" \
  93.         -command "tixColorEdit::SetScales $w RGBHSV" -variable $var -value 5
  94.  
  95.     tixDoWhenIdle tixColorEdit::SetScales $w V
  96.  
  97.     pack $w.menu.option -side left
  98.  
  99.     tk_menuBar $w.menu $w.menu.option
  100.  
  101.     # SET DATA STRUCT
  102.     #----------------
  103.     set data(menu1) $w.menu.option.m
  104.  
  105.     return $w.menu
  106. }
  107.  
  108. proc tixColorEdit::MkFrame2 {w} {
  109.     upvar #0 $w data
  110.     
  111.     frame $w.f2  -borderwidth 0
  112.     frame $w.f22 -relief raised -borderwidth 4
  113.     frame $w.f23 -borderwidth 0
  114.  
  115.     # Make the left side : color block
  116.     #--------------------------------
  117.     tixLabelFrame $w.labf -label "Selection"
  118.     set f [$w.labf subwidget frame]
  119.     frame $f.f -relief sunken -borderwidth 4 -bg black
  120.     tixColorBlock $f.cdemo
  121.     $f.cdemo config -rgb $data(-rgb)
  122.  
  123.     pack $f.cdemo -in $f.f -fill both -expand yes
  124.     pack $f.f -in $f -fill x -padx 15 -pady 5
  125.  
  126.     # Make the right side : color space
  127.     #----------------------------------
  128.     tixColorSpace $w.cspace -command "tixColorEdit::PickColor $w"
  129.     $w.cspace config -hsv $data(hsv)
  130.     pack $w.cspace -in $w.f22 -expand yes
  131.  
  132.     pack $w.labf -in $w.f2 -side left  -expand yes -fill both
  133.     pack $w.f22  -in $w.f2 -side right -expand yes
  134.  
  135.     set data(cdemo)  $f.cdemo
  136.     set data(cspace) $w.cspace
  137.     return $w.f2
  138. }
  139.  
  140. proc tixColorEdit::MkFrame3 {w} {
  141.     upvar #0 $w data
  142.  
  143.     set f [frame $w.f3]
  144.     set data(scale_frame) $f
  145.  
  146.     scale $f.scale1 -from 0.0 -to 1.000 -length 5c -orient horizontal \
  147.     -command "after 0 tixColorEdit::ScaleChange $w R" -label "Red" \
  148.     -bigincrement 5.0 -resolution 0.01
  149.     scale $f.scale2 -from 0.0 -to 1.000 -length 5c -orient horizontal \
  150.     -command "after 0 tixColorEdit::ScaleChange $w G" -label "Green" \
  151.     -bigincrement 5.0 -resolution 0.01
  152.     scale $f.scale3 -from 0.0 -to 1.000 -length 5c -orient horizontal \
  153.     -command "after 0 tixColorEdit::ScaleChange $w B" -label "Blue" \
  154.     -bigincrement 5.0 -resolution 0.01
  155.     scale $f.scale4 -from 0.0 -to 1.000 -length 5c -orient horizontal \
  156.     -command "after 0 tixColorEdit::ScaleChange $w H" -label "Hue" \
  157.     -bigincrement 5.0 -resolution 0.01
  158.     scale $f.scale5 -from 0.0 -to 1.000 -length 5c -orient horizontal \
  159.     -command "after 0 tixColorEdit::ScaleChange $w S" -label "Satuation" \
  160.     -bigincrement 5.0 -resolution 0.01
  161.     scale $f.scale6 -from 0.0 -to 1.000 -length 5c -orient horizontal \
  162.     -command "after 0 tixColorEdit::ScaleChange $w V" -label "Value" \
  163.     -bigincrement 5.0 -resolution 0.01
  164.  
  165.     pack $f.scale1 -fill x
  166.     pack $f.scale2 -fill x
  167.     pack $f.scale3 -fill x
  168.     pack $f.scale4 -fill x
  169.     pack $f.scale5 -fill x
  170.     pack $f.scale6 -fill x
  171.  
  172.     return $f
  173. }
  174.  
  175. #----------------------------------------------------------------------
  176. #                         Config Options
  177. #----------------------------------------------------------------------
  178. proc tixColorEdit::config-rgb {w arg} {
  179.     upvar #0 $w data
  180.  
  181.     tixColorEdit::RGBtoHSV $w
  182.     tixColorEdit::ResetScales $w
  183. }
  184.  
  185. proc tixColorEdit::config-state {w arg} {
  186.     upvar #0 $w data
  187.  
  188.     set f $w.f3
  189.  
  190.     if {$arg == "normal"} {
  191.     $f.scale1 config -state normal -fg $data(-foreground)
  192.     $f.scale2 config -state normal -fg $data(-foreground)
  193.     $f.scale3 config -state normal -fg $data(-foreground)
  194.     $f.scale4 config -state normal -fg $data(-foreground)
  195.     $f.scale5 config -state normal -fg $data(-foreground)
  196.     $f.scale6 config -state normal -fg $data(-foreground)
  197.     $data(cspace) config -state normal
  198.     } else {
  199.     $f.scale1 config -state disabled -fg $data(-disabledforeground)
  200.     $f.scale2 config -state disabled -fg $data(-disabledforeground)
  201.     $f.scale3 config -state disabled -fg $data(-disabledforeground)
  202.     $f.scale4 config -state disabled -fg $data(-disabledforeground)
  203.     $f.scale5 config -state disabled -fg $data(-disabledforeground)
  204.     $f.scale6 config -state disabled -fg $data(-disabledforeground)
  205.     $data(cspace) config -state disabled
  206.     }
  207. }
  208.  
  209. #----------------------------------------------------------------------
  210. #                         Internal commands
  211. #----------------------------------------------------------------------
  212. proc tixColorEdit::SetScales {w flag} {
  213.     if {![winfo exists $w]} {
  214.     return
  215.     }
  216.  
  217.     upvar #0 $w data
  218.  
  219.     if {$data(flag) == $flag} {
  220.     return
  221.     } else {
  222.     set data(flag) $flag
  223.     }
  224.  
  225.     case $flag in {
  226.     V {
  227.         set data(Rscale) 0
  228.         set data(Gscale) 0
  229.         set data(Bscale) 0
  230.         set data(Hscale) 0
  231.         set data(Sscale) 0
  232.         set data(Vscale) 1
  233.     }
  234.     RGB {
  235.         set data(Rscale) 1
  236.         set data(Gscale) 1
  237.         set data(Bscale) 1
  238.         set data(Hscale) 0
  239.         set data(Sscale) 0
  240.         set data(Vscale) 0
  241.  
  242.     }
  243.     HSV {
  244.         set data(Rscale) 0
  245.         set data(Gscale) 0
  246.         set data(Bscale) 0
  247.         set data(Hscale) 1
  248.         set data(Sscale) 1
  249.         set data(Vscale) 1
  250.     }
  251.     RGBV {
  252.         set data(Rscale) 1
  253.         set data(Gscale) 1
  254.         set data(Bscale) 1
  255.         set data(Hscale) 0
  256.         set data(Sscale) 0
  257.         set data(Vscale) 1
  258.     }
  259.     RGBHSV {
  260.         set data(Rscale) 1
  261.         set data(Gscale) 1
  262.         set data(Bscale) 1
  263.         set data(Hscale) 1
  264.         set data(Sscale) 1
  265.         set data(Vscale) 1
  266.     }
  267.     default {
  268.         return
  269.     }
  270.     }
  271.     tixColorEdit::ReplaceScales $w
  272. }
  273.  
  274. proc tixColorEdit::ReplaceScales {w} {
  275.     upvar #0 $w data
  276.  
  277.     set f $w.f3
  278.  
  279.     pack $f.scale1 -fill x
  280.     pack $f.scale2 -fill x -after $f.scale1
  281.     pack $f.scale3 -fill x -after $f.scale2
  282.     pack $f.scale4 -fill x -after $f.scale3
  283.     pack $f.scale5 -fill x -after $f.scale4
  284.     pack $f.scale6 -fill x -after $f.scale5
  285.  
  286.     if {$data(Rscale) == "0"} {
  287.     pack forget $f.scale1
  288.     }
  289.     if {$data(Gscale) == "0"} {
  290.     pack forget $f.scale2
  291.     }
  292.     if {$data(Bscale) == "0"} {
  293.     pack forget $f.scale3
  294.     }
  295.     if {$data(Hscale) == "0"} {
  296.     pack forget $f.scale4
  297.     }
  298.     if {$data(Sscale) == "0"} {
  299.     pack forget $f.scale5
  300.     }
  301.     if {$data(Vscale) == "0"} {
  302.     pack forget $f.scale6
  303.     }
  304.  
  305.     if {$data(-adjustsize)} {
  306.     after 100 tixColorEdit::ResetSize $w
  307.     }
  308.  
  309.     tixColorEdit::ResetScales $w
  310. }
  311.  
  312. proc tixColorEdit::ResetSize {w} {
  313.     upvar #0 $w data
  314.  
  315.     set top [winfo toplevel $w]
  316.     set W [winfo reqwidth  $top]
  317.     set H [winfo reqheight $top]
  318.     if {$W != 1 && $H != 1} {
  319.     wm geometry $top $W\x$H
  320.     } else {
  321.     tixWidgetDoWhenIdle tixColorEdit::ResetSize $w
  322.     }
  323. }
  324.  
  325. proc tixColorEdit::ResetScales {w} {
  326.     upvar #0 $w data
  327.  
  328.     tixColorEdit::ResetRGB $w
  329.     tixColorEdit::ResetHSV $w
  330.     $data(cspace) config -hsv $data(hsv)
  331.     $data(cdemo)  config -rgb $data(-rgb)
  332. }
  333.  
  334. proc tixColorEdit::ResetRGB {w} {
  335.     upvar #0 $w data
  336.  
  337.     set data(active) 0
  338.     set f $data(scale_frame)
  339.  
  340.     if {$data(Rscale) == "1"} {
  341.     $f.scale1 set [lindex $data(-rgb) 0]
  342.     }
  343.     if {$data(Gscale) == "1"} {
  344.     $f.scale2 set [lindex $data(-rgb) 1]
  345.     }
  346.     if {$data(Bscale) == "1"} {
  347.     $f.scale3 set [lindex $data(-rgb) 2]
  348.     }
  349.  
  350.     set data(active) 1
  351. }
  352.  
  353. proc tixColorEdit::ResetHSV {w} {
  354.     upvar #0 $w data
  355.  
  356.     set data(active) 0
  357.     set f $data(scale_frame)
  358.  
  359.     if {$data(Hscale) == "1"} {
  360.     $f.scale4 set [lindex $data(hsv) 0]
  361.     }
  362.     if {$data(Sscale) == "1"} {
  363.     $f.scale5 set [lindex $data(hsv) 1]
  364.     }
  365.     if {$data(Vscale) == "1"} {
  366.     $f.scale6 set [lindex $data(hsv) 2]
  367.     }
  368.     set data(active) 1
  369. }
  370.  
  371. proc tixColorEdit::ScaleChange {w flag value} {
  372.     if {![winfo exists $w]} {
  373.     return
  374.     }
  375.  
  376.     upvar #0 $w data
  377.  
  378.     if {$data(active) == "0"} {
  379.     return
  380.     }
  381.     set f $data(scale_frame)
  382.  
  383.     case $flag in {
  384.     {R G B} {
  385.         set r [$f.scale1 get]
  386.         set g [$f.scale2 get]
  387.         set b [$f.scale3 get]
  388.         set data(-rgb) "$r $g $b"
  389.         tixColorEdit::RGBtoHSV $w
  390.         tixColorEdit::ResetHSV $w
  391.         $data(cspace) config -hsv $data(hsv)
  392.          $data(cdemo)  config -rgb $data(-rgb)
  393.     }
  394.     {H S V} {
  395.         if {$data(Hscale) == "1"} {
  396.         set h [$f.scale4 get]
  397.         set s [$f.scale5 get]
  398.         } else {
  399.         set h [lindex $data(hsv) 0]
  400.         set s [lindex $data(hsv) 1]
  401.         }
  402.         set v [$f.scale6 get]
  403.  
  404.         # The following code tries to remember the
  405.         # H and S of a color when V becomes 0.
  406.         #
  407.         # ToDo: it doesn't work well ..
  408.         if {$v == 0} {
  409.         if {$data(oldhsv) == {}} {
  410.             set data(oldhsv) $data(hsv)
  411.         }
  412.         } else {
  413.         if {$data(oldhsv) != {}} {
  414.             set oldH [lindex $data(oldhsv) 0]
  415.             set oldS [lindex $data(oldhsv) 0]
  416.             set oldV [lindex $data(oldhsv) 0]
  417.  
  418.             if {$oldV != 0} {
  419.             set h $oldH
  420.             set s $oldS
  421.             }
  422.         }
  423.         set data(oldhsv) {}
  424.         }
  425.         set data(hsv) "$h $s $v"
  426.  
  427.         tixColorEdit::HSVtoRGB $w
  428.         tixColorEdit::ResetRGB $w
  429.         $data(cspace) config -hsv $data(hsv)
  430.          $data(cdemo)  config -rgb $data(-rgb)
  431.     }
  432.     }
  433.  
  434.     if {$data(-command) != {}} {
  435.     eval $data(-command) \
  436.         [lindex $data(-rgb) 0] \
  437.         [lindex $data(-rgb) 1] \
  438.         [lindex $data(-rgb) 2]
  439.     }
  440. }
  441.  
  442. proc tixColorEdit::PickColor {w h s v} {
  443.     upvar #0 $w data
  444.  
  445.     set data(hsv) "$h $s $v"
  446.     tixColorEdit::HSVtoRGB $w
  447.     tixColorEdit::ResetRGB $w
  448.     tixColorEdit::ResetHSV $w
  449.     $data(cdemo) config -rgb $data(-rgb)
  450.  
  451.     if {$data(-command) != {}} {
  452.     eval $data(-command) \
  453.         [lindex $data(-rgb) 0] \
  454.         [lindex $data(-rgb) 1] \
  455.         [lindex $data(-rgb) 2]
  456.     }
  457. }
  458.  
  459. proc tixColorEdit::RGBtoHSV {w} {
  460.     upvar #0 $w data
  461.     set data(hsv) [glwRgbToHsv \
  462.        [lindex $data(-rgb) 0] \
  463.        [lindex $data(-rgb) 1] \
  464.        [lindex $data(-rgb) 2]]
  465. }
  466.  
  467. proc tixColorEdit::HSVtoRGB {w} {
  468.     upvar #0 $w data
  469.     set data(-rgb) [glwHsvToRgb \
  470.        [lindex $data(hsv) 0] \
  471.        [lindex $data(hsv) 1] \
  472.        [lindex $data(hsv) 2]]
  473. }
  474.